home *** CD-ROM | disk | FTP | other *** search
/ PC go! 2008 April / PCgo 2008-04 (DVD).iso / interface / contents / demoversionen_3846 / 13664 / files / Data1.cab / box.cls < prev    next >
Encoding:
Visual Basic class definition  |  2004-03-05  |  14.4 KB  |  423 lines

  1. VERSION 1.0 CLASS
  2. BEGIN
  3.   MultiUse = -1  'True
  4.   Persistable = 0  'NotPersistable
  5.   DataBindingBehavior = 0  'vbNone
  6.   DataSourceBehavior  = 0  'vbNone
  7.   MTSTransactionMode  = 0  'NotAnMTSObject
  8. END
  9. Attribute VB_Name = "Box"
  10. Attribute VB_GlobalNameSpace = False
  11. Attribute VB_Creatable = True
  12. Attribute VB_PredeclaredId = False
  13. Attribute VB_Exposed = True
  14. Option Explicit
  15. '/******************************************************************/
  16. '/*                                                                */
  17. '/*                      TurboCAD for Windows                      */
  18. '/*                   Copyright (c) 1993 - 2001                    */
  19. '/*             International Microcomputer Software, Inc.         */
  20. '/*                            (IMSI)                              */
  21. '/*                      All rights reserved.                      */
  22. '/*                                                                */
  23. '/******************************************************************/
  24.  
  25. 'DBAPI constants
  26. Const gkGraphic = 11
  27. Const gkArc = 2
  28. Const gkText = 6
  29. Const gfCosmetic = 128&
  30.  
  31. 'Useful math constants
  32. Const Pi# = 3.14159265
  33.  
  34. 'Real variant types!
  35. Const typeEmpty = 0
  36. Const typeInteger = 2
  37. Const typeLong = 3
  38. Const typeSingle = 4
  39. Const typeDouble = 5
  40. Const typeCurrency = 6
  41. Const typeDate = 7
  42. Const typeString = 8
  43. Const typeObject = 9
  44. Const typeBoolean = 11
  45. Const typeVariant = 12
  46. Const typeIntegerEnum = typeInteger + 100
  47. Const typeLongEnum = typeLong + 100
  48. Const typeStringEnum = typeString + 100
  49.  
  50. 'Stock property pages
  51. Const ppStockPen = 1
  52. Const ppStockBrush = 2
  53. Const ppStockText = 4
  54. Const ppStockInsert = 8
  55. Const ppStockViewport = 16
  56. Const ppStockAuto = 32
  57.  
  58. 'Property Ids
  59. Const idRoundness = 1
  60. Const idText = 2
  61.  
  62. 'Property enums
  63.  
  64. 'Number of properties, pages, wizards
  65. Const NUM_PROPERTIES = 2
  66. Const NUM_PAGES = 1
  67. Const NUM_WIZARDS = 0
  68. Const formCaption = "Text Box"
  69. Private Sub Class_Initialize()
  70.     'Initialize class variables
  71. End Sub
  72.  
  73. 'Returns the user-visible description of this RegenMethod
  74. Public Property Get Description() As String
  75.     Description = "TextBox"
  76. End Property
  77.  
  78. 'Returns the persistent class id for this RegenMethod's property section
  79. Public Property Get ClassID() As String
  80.     ClassID = "{D25185FF-6A20-11d0-A115-00A024158DAF}"
  81. End Property
  82.  
  83. 'Retrieve types and names
  84. Public Function GetPropertyInfo(Names As Variant, Types As Variant, _
  85.     IDs As Variant, Defaults As Variant) As Long
  86.     ReDim Names(NUM_PROPERTIES), Types(NUM_PROPERTIES), _
  87.         IDs(NUM_PROPERTIES), Defaults(NUM_PROPERTIES)
  88.     Names(0) = "Roundness"
  89.     Types(0) = typeDouble
  90.     IDs(0) = idRoundness
  91.     Defaults(0) = 20
  92.     
  93.     Names(1) = "strText"
  94.     Types(1) = typeString
  95.     IDs(1) = idText
  96.     Defaults(1) = "Unknown"
  97.    
  98.     GetPropertyInfo = NUM_PROPERTIES
  99. End Function
  100.  
  101. 'Get the number of property pages supporting this RegenMethod
  102. Public Function GetPageInfo(ByVal AGraphic As Object, StockPages As Long, _
  103.     Names As Variant) As Long
  104.     ReDim Names(NUM_PAGES)
  105.  
  106.     'Need the form
  107. '    Load frmTextBox
  108. '    Names(0) = frmTextBox.Caption
  109. '    Unload frmTextBox
  110.     Names(0) = formCaption
  111.     StockPages = ppStockBrush + ppStockPen + ppStockAuto
  112.     GetPageInfo = NUM_PAGES
  113. End Function
  114.  
  115. Public Function GetWizardInfo(Names As Variant) As Long
  116.     ReDim Names(NUM_WIZARDS)
  117.     GetWizardInfo = NUM_WIZARDS
  118. End Function
  119.  
  120. 'Enumerate the names and values of a specified property
  121. Public Function GetEnumNames(ByVal PropID As Long, Names As Variant, Values As Variant) As Long
  122.     GetEnumNames = 0
  123. End Function
  124.  
  125. Public Function PageControls(ByVal ThisRegenMethod As Object, ByVal Graphic As Object, ByVal PageNumber As Long, ByVal SaveProperties As Boolean) As Boolean
  126.         'Set up error function
  127.         On Error GoTo Failed
  128.  
  129.         Dim Roundness#
  130.         Dim StrText$
  131.         If SaveProperties Then
  132.             'OK button on property page was clicked
  133.             'Form is still loaded
  134.             With frmTextBox
  135.                 'Need On Error statement for the case where you have
  136.                 'RRect Turbo Shape and ahother "shape" selected
  137.                 On Error Resume Next
  138.  
  139.                 'When the property page is closed, transfer the numeric
  140.                 'roundness value from the TextBox to the Graphic
  141.                 'Get the value as a double-precision number
  142.                 Roundness# = CDbl(.txtRoundness.Text)
  143.                 'Make sure it's between 0 and 100
  144.                 If Roundness# < 0# Then Roundness# = 0#
  145.                 If Roundness# > 100# Then Roundness# = 100#
  146.                 'Set the roundness property value in the Graphic
  147.                 Graphic.Properties("Roundness") = Roundness#
  148.                 
  149.                 StrText = .StrText.Text
  150.                 Graphic.Properties("strText") = StrText
  151.                 
  152.             End With
  153.         Else
  154.             'Property page is about to be opened
  155.             'Make sure the form is loaded
  156.             Load frmTextBox
  157.             With frmTextBox
  158.                 'If more than one RRect is selected and they do not
  159.                 'have the same properties, don't set up this field
  160.                 On Error GoTo NoRType
  161.  
  162.                 'When the property page is opening, transfer the numeric
  163.                 'roundness value from the Graphic to the TextBox
  164.                 'Get the roundness property value from the Graphic
  165.                 Roundness# = Graphic.Properties("Roundness")
  166.                 'Set the TextBox control's text
  167.                 .txtRoundness.Text = Roundness#
  168.                 StrText = Graphic.Properties("strText")
  169.                 .StrText.Text = StrText
  170.                 
  171. NoRType:
  172.             End With
  173.         End If
  174.  
  175.         PageControls = True
  176.         Exit Function
  177.  
  178. Failed:
  179.         'For debugging purposes, report that an error occurred
  180.         If Err.Number <> 0 Then
  181.             MsgBox "Error in PageControls: " & Err.Description
  182.         End If
  183.  
  184.         'Return false if an error occurred
  185.         PageControls = False
  186. End Function
  187.  
  188. Public Function PageDone(ByVal ThisRegenMethod As Object, Optional PageNumber As Variant)
  189.         'Done with form
  190.         Unload frmTextBox
  191. End Function
  192.  
  193. Public Function PropertyPages(ByVal ThisRegenMethod As Object, Optional PageNumber As Variant) As Boolean
  194.     With frmTextBox
  195.         .Show vbModal
  196.         PropertyPages = Not .DialogCanceled
  197.     End With
  198. End Function
  199.  
  200. Public Function Wizard(ByVal ThisRegenMethod As Object, Optional WizardNumber As Variant) As Boolean
  201.     Wizard = False
  202. End Function
  203.  
  204. 'Called when vertex has been moved, or other geometry change
  205. Public Function OnGeometryChanged(ByVal Graphic As Object, ByVal GeomID As Long, paramOld As Variant, paramNew As Variant)
  206.     'Do nothing
  207.     'Regen Graphic
  208. End Function
  209.  
  210. 'Called when vertex is moved, or other geometry change
  211. Public Function OnGeometryChanging(ByVal Graphic As Object, ByVal GeomID As Long, paramOld As Variant, paramNew As Variant) As Boolean
  212.     'OK to continue with change
  213.     OnGeometryChanging = True
  214. End Function
  215.  
  216. Public Function OnNewGraphic(ByVal grfThis As Object, ByVal boolCopy As Boolean) As Boolean
  217.     If boolCopy Then
  218.         'Vertices are already added for us...
  219.         OnNewGraphic = True
  220.         Exit Function
  221.     End If
  222.  
  223.     On Error GoTo Failed
  224.     'New Graphic being created
  225.     'X, Y, Z, PenDown, Selectable, Snappable, Editable, Linkable
  226.     'First Vertex is "lower left" corner i=0
  227.     grfThis.Vertices.Add 0#, 0, 0#, False, True, False, True, False
  228.     'Second Vertex is "upper right" corner i=1
  229.     grfThis.Vertices.Add 2#, 1, 0#, False, True, False, True, False
  230. '    Middle vertices
  231.     grfThis.Vertices.Add 1#, 0#, 0#, False, False, True, True, True
  232.     grfThis.Vertices.Add 2#, 0.5, 0#, False, False, True, True, True
  233.     grfThis.Vertices.Add 1#, 1#, 0#, False, False, True, True, True
  234.     grfThis.Vertices.Add 0#, 0.5, 0#, False, False, True, True, True
  235.     grfThis.Properties("LimitVertices") = 6
  236.     OnNewGraphic = True
  237.     Exit Function
  238.  
  239. Failed:
  240.     'Return false on failure
  241.     OnNewGraphic = False
  242. End Function
  243.  
  244. 'Function called whenever a copy of a graphic is being made
  245. Public Function OnCopyGraphic(ByVal grfCopy As Object, ByVal grfSource As Object) As Boolean
  246.     'Return false on failure
  247.     OnCopyGraphic = True
  248. End Function
  249.  
  250. 'Notification function called after graphic property is saved
  251. Public Function OnPropertyChanged(ByVal Graphic As Object, ByVal PropID As Long, _
  252.         ValueOld As Variant, ValueNew As Variant)
  253.     'Do nothing
  254. End Function
  255.  
  256. 'Notification function called when graphic property is saved
  257. Public Function OnPropertyChanging(ByVal Graphic As Object, ByVal PropID As Long, _
  258.         ValueOld As Variant, ValueNew As Variant) As Boolean
  259.     'OK to proceed
  260.     OnPropertyChanging = True
  261. End Function
  262.  
  263. 'Notification function called when graphic property is retrieved
  264. Public Function OnPropertyGet(ByVal Graphic As Object, ByVal PropID As Long)
  265.     'Do nothing
  266. End Function
  267.  
  268. 'Called when we need to update our object
  269. Public Function Regen(ByVal grfThis1 As Object)
  270.         'Setup error handler
  271.         On Error GoTo Failed
  272. Dim StrText$
  273. Dim grfThis As Graphic
  274.         Set grfThis = grfThis1
  275.         'Set up lock (prevent recursion)
  276.         Dim LockCount&
  277.         LockCount& = grfThis.RegenLock
  278.  
  279.         'Setup error handler (make sure lock is removed)
  280.         On Error GoTo FailedLock
  281.         If LockCount& = 0 Then
  282.             'Delete any previous cosmetic children
  283.             grfThis.Graphics.Clear gfCosmetic
  284.  
  285.             'Calculate height, width and radius of corners
  286.             Dim W#, H#, R#, Roundness#
  287.             Dim L#
  288.             Dim Round#
  289.                 Round = grfThis.Properties("Roundness")
  290.                 Roundness = CDbl(Round)
  291.  
  292.                 StrText = grfThis.Properties("strText")
  293.  
  294.             'Add child Graphics
  295.             Dim grfChild As Graphic
  296.             Dim x0#, y0#, x1#, y1#, T#
  297.             With grfThis.Vertices
  298.                 x0 = .Item(0).X
  299.                 y0 = .Item(0).Y
  300.                 x1 = .Item(1).X
  301.                 y1 = .Item(1).Y
  302.                 W# = Abs(x1 - x0)
  303.                 H# = Abs(y1 - y0)
  304.             End With
  305.             
  306.    
  307.             If Roundness = 0# Then
  308.                 'No rounded corners
  309.                 'All children are cosmetic
  310.                 Set grfChild = grfThis.Graphics.Add(11)
  311.                 grfChild.Cosmetic = True
  312.                 'Now add vertices to the child
  313.                 With grfChild.Vertices
  314.                     .Add x0#, y0#, 0
  315.                     .Add x0#, y1#, 0, True
  316.                     .Add x1#, y1#, 0, True
  317.                     .Add x1#, y0#, 0, True
  318.                     'Close the rectangle
  319.                     .AddClose True 'PenDown
  320.                 End With
  321.             Else
  322.             
  323. Dim Htext#
  324.  
  325. Dim x3#, x2#, y3#, y2#
  326.                 Set grfChild = grfThis.Graphics.AddText(StrText, (x0 + x1) / 2#, y1, 0, y1 - y0, 0, 0, , 2)
  327.                 grfChild.Cosmetic = True
  328.                 grfChild.Properties.Item("TextMode").Value = 2
  329.                 x3 = grfChild.Vertices.Item(3).X
  330.                 x2 = grfChild.Vertices.Item(2).X
  331. Dim Matr As Matrix
  332.                 Set Matr = grfChild.Scale(0.95 * (x1 - x0) / (x3 - x2), 1, 1)
  333.             With grfThis.Vertices
  334.                  .Item(2).X = (x1 + x0) / 2#
  335.                  .Item(2).Y = y0
  336.  
  337.                  .Item(3).X = x1
  338.                  .Item(3).Y = (y1 + y0) / 2#
  339.  
  340.                  .Item(4).X = (x1 + x0) / 2#
  341.                  .Item(4).Y = y1
  342.  
  343.                  .Item(5).X = x0
  344.                  .Item(5).Y = (y1 + y0) / 2#
  345.             End With
  346.  
  347.  H = Abs(y1 - y0)
  348.  R = H / 2# * Roundness / 100#
  349.  
  350.                 
  351.                 'Rounded corners
  352.                 'We'll make 4 line children and 4 arc children
  353.                 'First line
  354.                 'All children are cosmetic
  355.                 Set grfChild = grfThis.Graphics.Add(11)
  356.                 grfChild.Cosmetic = True
  357.                 'Now add vertices to the child
  358.                 With grfChild.Vertices
  359.                     .Add x0# + R#, y0#, 0
  360.                     .Add x1# - R#, y0#, 0, True
  361.                 End With
  362.                 'First arc
  363.                 Set grfChild = grfThis.Graphics.Add(gkArc)
  364.                 grfChild.Cosmetic = True
  365.                 grfChild.ArcSet x1# - R#, y0# + R#, 0#, R#, , 1.5 * Pi#, 0#
  366.                 'Second line
  367.                 Set grfChild = grfThis.Graphics.Add(11)
  368.                 grfChild.Cosmetic = True
  369.                 With grfChild.Vertices
  370.                     .Add x1#, y0# + R#, 0
  371.                     .Add x1#, y1# - R#, 0, True
  372.                 End With
  373.                 'Second arc
  374.                 Set grfChild = grfThis.Graphics.Add(gkArc)
  375.                 grfChild.Cosmetic = True
  376.                 grfChild.ArcSet x1# - R#, y1# - R#, 0#, R#, , 0#, 0.5 * Pi#
  377.                 'Third line
  378.                 Set grfChild = grfThis.Graphics.Add(11)
  379.                 grfChild.Cosmetic = True
  380.                 With grfChild.Vertices
  381.                     .Add x1# - R#, y1#, 0
  382.                     .Add x0# + R#, y1#, 0, True
  383.                 End With
  384.                 'Third arc
  385.                 Set grfChild = grfThis.Graphics.Add(gkArc)
  386.                 grfChild.Cosmetic = True
  387.                 grfChild.ArcSet x0# + R#, y1# - R#, 0#, R#, , 0.5 * Pi#, Pi#
  388.                 'Fourth line
  389.                 Set grfChild = grfThis.Graphics.Add(11)
  390.                 grfChild.Cosmetic = True
  391.                 With grfChild.Vertices
  392.                     .Add x0#, y1# - R#, 0
  393.                     .Add x0#, y0# + R#, 0, True
  394.                 End With
  395.                 'Fourth arc
  396.                 Set grfChild = grfThis.Graphics.Add(gkArc)
  397.                 grfChild.Cosmetic = True
  398.                 grfChild.ArcSet x0# + R#, y0# + R#, 0#, R#, , Pi#, 1.5 * Pi#
  399.             End If
  400.         grfThis.RegenUnlock
  401.  
  402.             'Add visible child Graphics
  403.         End If
  404.  
  405.         grfThis.RegenUnlock
  406.  
  407.         Exit Function
  408.  
  409. FailedLock:
  410.         'Remove lock
  411.         grfThis.RegenUnlock
  412.  
  413. Failed:
  414. End Function
  415.  
  416. Public Function Draw(ByVal grfThis As Object, ByVal view As Object, Optional mat As Variant) As Boolean
  417.     'Return True if we did the redraw (no further processing necessary, no children will be drawn).
  418.     'Since this is just a test, we return False to let TurboCAD do the drawing operation.
  419.     Draw = False
  420. End Function
  421.  
  422.  
  423.